home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / src-server / wc_Form.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-10-04  |  6.2 KB  |  165 lines
  1. /* -*-C-*-
  2. ********************************************************************************
  3. *
  4. * File:         wc_Form.c
  5. * RCS:          $Header: wc_Form.c,v 1.3 91/03/14 03:14:41 mayer Exp $
  6. * Description:  XM_FORM_WIDGET_CLASS
  7. * Author:       Niels Mayer, HPLabs
  8. * Created:      Fri Oct 27 22:35:52 1989
  9. * Modified:     Thu Oct  3 21:52:59 1991 (Niels Mayer) mayer@hplnpm
  10. * Language:     C
  11. * Package:      N/A
  12. * Status:       X11r5 contrib tape release
  13. *
  14. * WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. * XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. *
  17. * Permission to use, copy, modify, distribute, and sell this software and its
  18. * documentation for any purpose is hereby granted without fee, provided that
  19. * the above copyright notice appear in all copies and that both that
  20. * copyright notice and this permission notice appear in supporting
  21. * documentation, and that the name of Hewlett-Packard and David Betz not be
  22. * used in advertising or publicity pertaining to distribution of the software
  23. * without specific, written prior permission.  Hewlett-Packard and David Betz
  24. * make no representations about the suitability of this software for any
  25. * purpose. It is provided "as is" without express or implied warranty.
  26. *
  27. * HEWLETT-PACKARD AND DAVID BETZ DISCLAIM ALL WARRANTIES WITH REGARD TO THIS
  28. * SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS,
  29. * IN NO EVENT SHALL HEWLETT-PACKARD NOR DAVID BETZ BE LIABLE FOR ANY SPECIAL,
  30. * INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  31. * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  32. * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  33. * PERFORMANCE OF THIS SOFTWARE.
  34. *
  35. * See ./winterp/COPYRIGHT for information on contacting the authors.
  36. * 
  37. * Please send modifications, improvements and bugfixes to mayer@hplabs.hp.com
  38. * Post XLISP-specific questions/information to the newsgroup comp.lang.lisp.x
  39. *
  40. ********************************************************************************
  41. */
  42. static char rcs_identity[] = "@(#)$Header: wc_Form.c,v 1.3 91/03/14 03:14:41 mayer Exp $";
  43.  
  44. #include <stdio.h>
  45. #include <Xm/Xm.h>
  46. #include <Xm/Form.h>
  47. #include "winterp.h"
  48. #include "user_prefs.h"
  49. #include "xlisp/xlisp.h"
  50. #include "w_funtab.h"
  51.  
  52.  
  53. extern Widget Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(); /* w_classes.c */
  54.  
  55.  
  56. /*****************************************************************************
  57.  * (send XM_FORM_WIDGET_CLASS :new 
  58.  *                           [:managed/:unmanaged]
  59.  *                           [:dialog]
  60.  *                           [<name>]
  61.  *                           <parent> 
  62.  *                           [:XMN_<arg1> <val1>]
  63.  *                           [. . .             ]
  64.  *                           [:XMN_<argN> <valN>])
  65.  *
  66.  * The optional keyword submessage :managed will cause a subsequent call
  67.  * to XtManageChild(). If the submessage :unmanaged is present, or no
  68.  * submessage, then XtManageChild() won't be called, and the resulting
  69.  * widget will be returned unmanaged.
  70.  *
  71.  *     (send XM_FORM_WIDGET_CLASS :new ...)
  72.  *     --> XmCreateForm();
  73.  *     (send XM_FORM_WIDGET_CLASS :new :dialog ...)
  74.  *     --> XmCreateFormDialog();
  75.  ****************************************************************************/
  76. LVAL Xm_Form_Widget_Class_Method_ISNEW()
  77. {
  78.   extern ArgList Wres_Get_LispArglist(); /* from w_resources.c */
  79.   extern void    Wres_Free_C_Arglist_Data(); /* from w_resources.c */
  80.   extern LVAL k_managed, k_unmanaged, k_dialog;
  81.   LVAL self, o_parent;
  82.   char* name;
  83.   Boolean managed_p, dialog_p;
  84.   Widget parent_widget_id, widget_id;
  85.  
  86.   self = xlgaobject();        /* NOTE: xlobj.c:clnew() returns an OBJECT; if this method
  87.                    returns successfully, it will return a WIDGETOBJ */
  88.  
  89.   /* get optional managed/unmanaged arg */
  90.   if (moreargs() && ((*xlargv == k_managed) || (*xlargv == k_unmanaged)))
  91.     managed_p = (nextarg() == k_managed);
  92.   else
  93.     managed_p = FALSE;        /* by default don't call XtManageChild() */
  94.  
  95.   /* get optional :dialog arg */
  96.   if (moreargs() && (*xlargv == k_dialog)) {
  97.     nextarg();
  98.     dialog_p = TRUE;
  99.   }
  100.   else
  101.     dialog_p = FALSE;        /* by default, we don't want a dialog widget */
  102.  
  103.   /* get optional <name> arg */
  104.   if (moreargs() && (stringp(*xlargv)))
  105.     name = (char*) getstring(nextarg());
  106.   else
  107.     name = "";            /* default name */
  108.  
  109.   /* get required <parent> widget-object arg */
  110.   parent_widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&o_parent);
  111.  
  112.   /*
  113.    * Store the widget object <self> in the XmNuserData resource on the
  114.    * widget. This will allow us to retrieve the widget object from Xtoolkit
  115.    * functions returning widget ID's without having to keep around a table
  116.    * of widgetID-->widget-objects.
  117.    */
  118.    ARGLIST_RESET(); ARGLIST_ADD(XmNuserData, (XtArgVal) self); 
  119.  
  120.   if (moreargs()) {        /* if there are more arguments, */
  121.     Cardinal xt_numargs;    /* then we have some extra widget resources to set */
  122.     ArgList xt_arglist = Wres_Get_LispArglist(self, parent_widget_id, ARGLIST(), &xt_numargs);
  123.     if (dialog_p)
  124.       widget_id = XmCreateFormDialog(parent_widget_id, name, xt_arglist, xt_numargs);
  125.     else
  126.       widget_id = XmCreateForm(parent_widget_id, name, xt_arglist, xt_numargs);
  127.     Wres_Free_C_Arglist_Data();
  128.   }
  129.   else 
  130.     if (dialog_p)
  131.       widget_id = XmCreateFormDialog(parent_widget_id, name, ARGLIST());
  132.     else
  133.       widget_id = XmCreateForm(parent_widget_id, name, ARGLIST());
  134.  
  135.   Wcls_Initialize_WIDGETOBJ(self, widget_id);
  136.  
  137.   if (managed_p)
  138.     XtManageChild(widget_id);
  139.  
  140. #ifdef DEBUG_WINTERP_1
  141.   Wcls_Print_WidgetObj_Info(self);
  142. #endif
  143.   return (self);
  144. }
  145.  
  146.  
  147. /******************************************************************************
  148.  *
  149.  ******************************************************************************/
  150. Wc_Form_Init()
  151. {
  152.   LVAL o_XM_FORM_WIDGET_CLASS;
  153.   extern LVAL Wcls_Create_Subclass_Of_WIDGET_CLASS(); /* w_classes.c */
  154.   extern      xladdmsg();    /* from xlobj.c */
  155.  
  156.   o_XM_FORM_WIDGET_CLASS =
  157.     Wcls_Create_Subclass_Of_WIDGET_CLASS("XM_FORM_WIDGET_CLASS",
  158.                      xmFormWidgetClass);
  159.  
  160.   /* a special :isnew method on this class allows for the creation of this
  161.      widget in a popup dialog if the submessage keyword :dialog is given ... */
  162.   xladdmsg(o_XM_FORM_WIDGET_CLASS, ":ISNEW", 
  163.        FTAB_Xm_Form_Widget_Class_Method_ISNEW);
  164. }
  165.